;;########################################################################
;; anovavis.lsp
;; Copyright (c) 1993-98 by Forrest W. Young
;; anovavis.lsp and anovavs2.lsp contain the code for anova visualization.
;;########################################################################

(require "vista")

(defmeth anova-model-object-proto :visualize (&optional univar)
"arg: Univar indicates when t that visualization if for univar"
  (if (not (eq current-object self)) (setcm self))
  (let* ((my-data (send self :data-object))
         (my-self self)
         (nway (send self :nway-model))
         (bp nil) (dnl nil) (lp nil) (rp nil)
         (bp-y-range nil)
         (bp-y-axis nil)
         (nways (send self :nways))
         (ways (send self :ways))
         (sources (send nway :source-names))
         (response (send self :response))
         (design (combine (strcat response " (Overall)") sources))
         (data (combine (send self :data)))
         (data-mean (mean data))
         (grouped-data (send self :grouped-data 0))
         (level-names (send self :level-names))
         (hf-labels (mapcar #'(lambda (str) (strcat str " " response))
                           (first level-names)))
         (binwidth-list (repeat nil (length design)))
         (point-labels 
          (if (equal (send my-data :slot-value 'proto-name) 
                     (send table-data-object-proto :slot-value 'proto-name))
             (send my-data :obs-labels)
             (send self :labels)))
         (bp (boxplot 
              data 
              :show nil :diamonds t :mean-line t  :boxes nil :median-line nil
              :point-labels point-labels
              :y-axis-label response
              :variable-labels (list (strcat response "(Overall)"))))
         (hf (histofreq data :variable-labels hf-labels
                        :new-x t :show nil))
         (dnl (name-list design :show nil :title "Sources" :help-only t :hot-spot nil))
         (lp (leverage-plot 0 self
                            :point-labels point-labels
                            :variable-labels (list (strcat "Predicted "
                                             response) response)
                            :y-range (send bp :range 1)
                            :y-axis  (send bp :y-axis)
                            :y-mean data-mean
                            :show nil))
         (rp (anova-residual-plot self :show nil :point-labels point-labels))
         (pp (plot-points (1+ (* 2 (iseq (length grouped-data))))
                          (mapcar #'mean grouped-data)
                          :title "Profile Plot" :show nil))
         
         (sp (spread-plot (if univar
                              (matrix '(2 2)
                                      (list bp (list hf dnl) lp (list rp pp)))
                              (matrix '(2 3) 
                                  (list bp hf dnl lp rp pp)))))
         (plot-matrix (send sp :plot-matrix))
         )
    (defmeth sp :spreadplot-help ()
      (plot-help-window (strcat "SpreadPlot Help"))
      (paste-plot-help (format nil "This is the SpreadPlot for the Analysis of Variance. In this SpreadPlot clicking on an entry in the Sources window changes the ANOVA source for which information is displayed in the other windows.~2%"))
      (show-plot-help)
      (send spreadplot-proto :spreadplot-help :points t :flush nil))

    (send bp :y-axis t t (third (send bp :y-axis)))
    (send bp :variable-label 1 response)
    (send bp :showing-labels t)
    (send bp :mouse-mode 'brushing)
    (send bp :linked t)
    (defmeth bp :plot-help ()
      (plot-help-window (strcat "Help: " (send self :title)))
      (paste-plot-help (format nil 
"This plot displays a side-by-side Box, Diamond and Dot plot for each of the levels of a source in your data. The choice of sources is determined by clicking in the SOURCES window. By clicking on various SOURCES it is possible to see side-by-side box-plots for all levels of each main source and each two-way interaction.~2%"))
      (show-plot-help)
      (call-next-method :flush nil))
    (setf bp-y-range (send bp :range 1))
    (setf bp-y-axis  (send bp :y-axis))
    
    (defmeth graph-proto :new-var (axis)
      (let* ((result (send self :new-variable-dialog axis)))
        (if (> (length result) 0)
            (if (first result)
                (send self :show-new-var axis (first result))
                (error-message "You must select a variable")))))

 
    (send dnl :use-color t)
    (send dnl :menu nil)
    (send dnl :fix-name-list)

    (defmeth dnl :do-select-click (&rest args)
      (apply #'call-next-method args)
      (when (send self :selection)
            (let* ((sel (first (send self :selection)))
                   (num (send self :num-points))
                   (ways (send my-self :ways))
                   (nways (send my-self :nways)))
              (cond
                ((= sel 0) 
                 (send my-self :profile-labels nil)
                 (send bp :new-plot (combine (send my-self :data))
                       :point-labels point-labels
                       :variable-labels " "
                     ;  (strcat response " (Overall)")
                       )
                 (send hf :new-plot-data (combine (send my-self :data))
                       :binwidth (select binwidth-list sel)
                       :variable-labels response)
                 (send pp :clear)
                 (send pp :variable-label 0 "")
                 (send pp :redraw)
                 (send rp :source 0)
                 (send rp :new-plot 0 :x-range bp-y-range :x-axis bp-y-axis
                       :point-labels point-labels)
                 (send lp :new-plot 0 my-self
                       :point-labels point-labels
                       :y-range bp-y-range :y-axis bp-y-axis
                       :y-mean data-mean))
                ( t
                  (when (<= sel nways)
                        (send my-self :profile-labels 
                              (nth (1- sel) (send my-self :classes))))
                  (let* ((grouped-data-and-labels 
                          (send my-self :grouped-data (1- sel) point-labels))
                         (grouped-data (first grouped-data-and-labels))
                         (permuted-point-labels 
                          (combine (second grouped-data-and-labels))))
                    (setf hf-labels 
                          (mapcar #'(lambda (str) (strcat str " " response))
                                  (nth (1- sel) (send my-self :level-names))))
                    (send bp :new-plot grouped-data
                        :point-labels permuted-point-labels
                        :variable-labels 
                        (nth (1- sel) (send my-self :level-names)))
                    (send hf :new-plot-data grouped-data
                          :variable-labels hf-labels)
                    (send rp :source sel)
                    (send rp :new-plot sel
                          :x-range bp-y-range :x-axis bp-y-axis
                          :point-labels point-labels)
                    (send lp :new-plot sel my-self
                          :point-labels point-labels
                          :y-range bp-y-range :y-axis bp-y-axis
                          :y-mean data-mean)
                    (send pp :new-plot 
                          (send my-self :grouped-data (1- sel)) sel)))))))
    
    (defmeth dnl :plot-help ()
      (plot-help-window (strcat "Help: " (send self :title)))
      (paste-plot-help (format nil 
"This window displays sources of information in the data. A source is either the OVERALL data (i.e., the response variable itself), a main way of the data, or a combination of two ways of the data. Clicking on a source in the SOURCES window changes what is seen in all of the other plots. See the help for those plots for information about what they display.~2%"))
      (show-plot-help))
    
    (send lp :linked t)
    (send lp :showing-labels t)
    (send lp :plot-buttons :new-x nil :new-y nil); :margin '(0 17 0 0) 
    (send lp :mouse-mode 'brushing)
    (send lp :legend1 (send self :name))
    (send lp :legend2 "Regression and Fit")

    (send rp :linked t)
    (send rp :showing-labels t)
    (send rp :plot-buttons :new-x nil :new-y nil);:margin '(0 17 0 20)
    (send rp :mouse-mode 'brushing)
    (send rp :legend1 (send self :name))
    (send rp :legend2 "Residuals")

    (send pp :use-color t)
    (send pp :range 0 0 (* 2 (length grouped-data)))
    (send pp :range 1 (first (send bp :range 1)) 
          (second (send bp :range 1)))
    (send pp :x-axis t t 0)
    (send pp :clear)
    (send pp :variable-label 0 "")
    (send pp :variable-label 1 (strcat response " LS Means"))
    (send pp :y-axis t t (third (send bp :y-axis)))
    (send pp :menu nil)
    (send pp :plot-buttons :new-x nil :new-y nil :mouse-mode nil);:margin '(0 17 0 20) 
    (send rp :mouse-mode 'brushing)
    (send pp :add-mouse-mode 'no-action
          :title "No Action"
          :click :do-nothing
          :cursor 'no-action)
    (send pp :mouse-mode 'no-action)
    (send pp :pop-out nil)
    (send my-self :profile-labels (first (send my-self :classes)))
    (defmeth pp :plot-help ()
      (plot-help-window (strcat "Help: " (send self :title)))
      (paste-plot-help (format nil 
"The profile plot displays the Least Squared marginal means (LS Means) for each of the groups. The means are connected by a line to emphasize the relationship between groups.~2%"))
     (paste-plot-help (format nil "When the selected source is an interaction term, there will be several profile lines. When these profile lines are roughly parallel, there is no significant interaction effect. If the lines are not parallel or are intersecting, there may be a significant interaction.~2%"))
      (show-plot-help))
    ;(send pp :plot-buttons :margin '(0 17 0 20) :new-x nil :new-y nil)
    (defmeth pp :new-plot (grouped-data sel)
      (let* ((x (1+ (* 2 (iseq (length grouped-data)))))
             (y (mapcar #'mean grouped-data))
             (y1 nil)
             (nways (send my-self :nways))
             (knt nways)
             (nlevels (send my-self :nclasses))
             (inow nil)
             (ilevels nil)
             (jlevels nil))
        (send my-self :line-labels nil)
        (send my-self :line-xs nil)
        (send my-self :line-ys nil)
        (send pp :start-buffering)
        (send pp :clear)
        (send pp :variable-label 0 (strcat response "(Overall)"))
        (send pp :range 0 0 0)
        (cond ((<= sel nways)
               (send pp :add-points x y :color 'blue)
               (send my-self :profile-labels 
                     (nth (1- sel) (send my-self :classes)))
               (send pp :add-lines x y :color 'blue :width 2)
               (send pp :variable-label 0 (nth (1- sel) 
                                               (send my-self :ways)))
               (send pp :range 0 0 (* 2 (length grouped-data))))
          (t (dotimes (i (- nways 1))
                      (dolist (j (iseq (1+ i) (- nways 1)))
                              (setf knt (1+ knt))
                              (when (= knt sel)
                                    (send pp :variable-label 0 
                                          (nth j (send my-self :ways)))
                                    (send my-self :profile-labels 
                                          (nth j (send my-self :classes)))
                                    (setf inow i)
                                    (setf ilevels (nth i nlevels))
                                    (setf jlevels (nth j nlevels)))))
             (setf x (1+ (* 2 (iseq jlevels))))
             (dotimes (i ilevels)
                      (setf y1 (select y (iseq (* i jlevels) 
                                            (+ (* i jlevels) (1- jlevels)))))
                      (send pp :add-points x y1 :color 'blue)
                      (send pp :add-lines  x y1 :color 'blue :width 2)
                      (send my-self :line-labels
                            (add-element-to-list 
                             (send my-self :line-labels) 
                             (nth i (nth inow (send my-self :classes)))))
                      (send my-self :line-xs
                            (add-element-to-list (send my-self :line-xs)
                                                 (first (last x))))
                      (send my-self :line-ys
                            (add-element-to-list (send my-self :line-ys)
                                                 (first (last y1))))
                      )
             (send pp :range 0 0 (* 2 (length x)))))
        (send pp :buffer-to-screen)
        ))

    (defmeth pp :redraw ()
      (send self :start-buffering)
      (call-next-method)
      (when (> (send self :num-points) 0) (send self :label-x-axis))
      (send self :buffer-to-screen))
    
    (defmeth pp :label-x-axis ()
      (let* ((labels (send my-self :profile-labels))
             (line-labels (send my-self :line-labels))
             (h (send self :canvas-height))
             (x (send self :point-canvas-coordinate 0 (iseq (length labels))))
             (o (first (send self :content-origin)))) 
        (dotimes (i (length labels))
                 (send self :draw-line (+ o (nth i x)) (- h 45) 
                       (+ o (nth i x)) (- h 40))
                 (send self :draw-text (select labels i) 
                       (+ o (nth i x)) (- h 25) 1 0))
        (when (send my-self :line-labels)
              (dotimes (i (length line-labels))
                       (send self :add-line-label
                             (nth i (send my-self :line-labels))
                             (nth i (send my-self :line-xs))
                             (nth i (send my-self :line-ys)))))
        ))

    (defmeth pp :add-line-label (label x y)
      (let* ((xyc (send self :real-to-canvas x y)))
        (send self :draw-text label (+ 5 (first xyc))
              (+ 3 (second xyc)) 0 0)))

    (defmeth dnl :do-click (x y m1 m2)
      (call-next-method x y m1 m2))

    (send dnl :selection '(1))
    (send dnl :do-select-click 18 25 nil nil)
    ;(send hg :show-new-var "x" 0)
    ;(send hg :switch-add-normal)
    (send rp :pop-out nil)
    (send lp :pop-out nil)
    (send sp :show-spreadplot)
    (send dnl :selection '(1))
    (send dnl :do-select-click 18 25 nil nil)
    (pause 10)
    ;(send hg :switch-add-normal :line-width 2)
    ;(send hg :redraw)
    (when univar
          (send dnl :remove)
          (send pp :remove))
    t))

(defmeth anova-model-object-proto :grouped-cooks (source)
  (let* ((nway (send self :nway-model))
         (cooks (combine (send nway :cooks-distances)))
         (indicator (nth source (send nway :indicator-matrices)))
;(indicator (nth source (send (send self :data-object) :indicator-matrices)))
         (nclasses (second (size indicator)))
         (members nil)
         (grouped-cooks nil))
    (dotimes (i nclasses)
             (setf members (select cooks (which (= 1 (col indicator i)))))
             (setf grouped-cooks (append grouped-cooks 
                                             (list members))))
    grouped-cooks))

(defmeth anova-model-object-proto :grouped-residuals (source type)
  (let* ((nway (send self :nway-model))
         (residuals nil)
;(indicator (nth source (send (send self :data-object) :indicator-matrices)))
         (indicator (nth source (send self :indicator-matrices)))
         (nclasses (second (size indicator)))
         (members nil)
         (grouped-residuals nil))
    (cond ((equalp type "Raw")
           (setf residuals (combine (send nway :residuals))))
          ((equalp type "Studentized")
           (setf residuals (combine (send nway :studentized-residuals))))
          ((equalp type "Externally Studentized")
           (setf residuals (combine 
                            (send nway :externally-studentized-residuals))))) 
    (dotimes (i nclasses)
             (setf members (select residuals (which (= 1 (col indicator i)))))
             (setf grouped-residuals (append grouped-residuals 
                                             (list members))))
    grouped-residuals))


; ******* ANOVA Residual Plot ************
; should inherit from residual-plot-proto, but doesn't out of lack of time

(defproto anova-residual-plot-proto '(model-object resid-type source) () vista-scatterplot-proto)

(defun anova-residual-plot 
  (model-object &key (title "Residual Plot") 
     (variable-labels (list "LS Means" "Residuals"))
     point-labels location size (go-away t) (show t))
  (send anova-residual-plot-proto :new model-object
        :title title :point-labels point-labels
        :variable-labels variable-labels :location location 
        :size size :go-away go-away :show show))

(defun rplot (model-object &rest args)
  (apply #'residual-plot model-object args))

(defmeth anova-residual-plot-proto :model-object (&optional (obj-id nil set))
  (if set (setf (slot-value 'model-object) obj-id))
  (slot-value 'model-object))

(defmeth anova-residual-plot-proto :resid-type (&optional (name1 nil set))
  (if set (setf (slot-value 'resid-type) name1))
  (slot-value 'resid-type))

(defmeth anova-residual-plot-proto :source (&optional (name1 nil set))
  (if set (setf (slot-value 'source) name1))
  (slot-value 'source))

(defmeth anova-residual-plot-proto :isnew 
  (model-object &key title variable-labels point-labels location 
               size go-away show)
  (call-next-method 2 :title title 
                    :location location :size size :go-away go-away :show nil)
  (send self :new-menu "ResidPlot" 
              :items '(LINK SHOWING-LABELS MOUSE RESIZE-BRUSH DASH 
                            ERASE-SELECTION FOCUS-ON-SELECTION SHOW-ALL 
                            SYMBOL COLOR SELECTION))
  (send self :model-object model-object)
  (send self :resid-type "Studentized")
  (send self :source 0)
  (send self :new-plot 0 :point-labels point-labels)
  (when show (send self :show-window))
  self)

(defmeth anova-residual-plot-proto :new-plot 
  (&optional sel &key x-range x-axis point-labels)
  (let* ((model-obj (send self :model-object))
         (resp-var-name (send model-obj :response))
         (type (send self :resid-type))
         (type-name type))
    (if (equalp type "Studentized") (setf type-name "Standardized"))
    (send self :start-buffering)
    (send self :clear)
    (when (and sel (> sel 0))
          (let* ((grouped-data-and-labels 
                  (send model-obj :grouped-data (1- sel) point-labels))
                 (grouped-data (first grouped-data-and-labels))
                 (permuted-point-labels 
                  (combine (second grouped-data-and-labels)))
                 (means (mapcar #'mean grouped-data))
                 (lsmeans nil)
                 (way (select (send model-obj :source-names) (1- sel)))
                 (residuals 
                  (send model-obj :grouped-residuals (1- sel) type)))
            (setf lsmeans (combine (map-elements 
                                    #'(lambda (x y) (repeat x (length y)))
                                    means grouped-data)))
            (send self :add-points lsmeans (combine residuals) 
                  :color 'blue :symbol 'square)
            (send self :point-label 
                  (iseq (length point-labels)) permuted-point-labels)
            (send self :variable-label '(0) 
                  (strcat resp-var-name " LS Means for " way))
            (send self :variable-label '(1) (strcat type-name " Residuals"))))
    (when (or (not sel) (= sel 0))
          (let* ((nway (send model-obj :nway-model))
                 (resids nil)
                 (yhat (send nway :fit-values))
                 )
            (cond ((equalp type "Raw") (setf resids (send nway :residuals)))
              ((equalp type "Studentized")
               (setf resids (send nway :studentized-residuals)))
              ((equalp type "Externally Studentized")
               (setf resids 
                     (send nway :externally-studentized-residuals))))
            (send self :add-points yhat resids :color 'blue :symbol 'square)
            (send self :point-label (iseq (length point-labels)) point-labels)
            (send self :variable-label '(0) 
                  (strcat resp-var-name " LS Means"))
            (send self :variable-label '(1) "Standardized Residuals")))
    (send self :adjust-to-data)
    (apply #'send self :range 0 x-range)
    (apply #'send self :x-axis x-axis)
    (send self :abline 0.0 0.0)
    (send self :buffer-to-screen)))

(defmeth anova-residual-plot-proto :change-y-axis ()
  (send self :get-residuals))

(defmeth anova-residual-plot-proto :plot-help ()
  (plot-help-window (strcat "Help for " (send self :title)))
  (paste-plot-help (format nil 
"The residuals plot is a plot of the standardized residuals versus the Least Squared (LS) Means for the selected ANOVA source. The LS Means are the values of the response variable that are predicted by the selected source. Since the LS Mean for a given level of the selected source is the same for all observations within that level, the plot shows vertical lines of dots. The dots in a line are the observations within a level of the source.~2%"))
  (paste-plot-help (format nil 
"The residuals plot is an ANOVA diagnostic plot: It helps diagnose the suitability of the assumptions underlying ANOVA for the data being analyzed. Residual plots may be used to detect nonnormal error distributions, non-constant error variance (heteroscedasticity), nonlinearity and outliers.~2%"))
  (paste-plot-help (format nil 
"NORMALITY: The points in the plot should be normally distributed about the zero line within each source level. If they are not, then the assumption of normality has probably not been met.~2%"))
  (paste-plot-help (format nil 
"LINEARITY: Points that form a systematic pattern within a souce level suggest that the assumption of linearity has been violated.~2%"))
  (paste-plot-help  (format nil "HETEROSCADASTICITY: The variance of the residuals should be about the same for all source levels. If the variance changes systematically across the levels, then the assumption of constant error variance has not been met.~2%"))
  (paste-plot-help  (format nil "OUTLIERS: Outliers may be identified by examining observations which have residuals that are much larger than the rest of the residual values. There should be no outliers.~2%"))
  (show-plot-help)
  )

;(load (strcat *vista-dir-name* "anovavs2")) 